home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / progjrn / pj_6_6.arc / FCODE.ARC / SWHETR.FOR < prev    next >
Encoding:
Text File  |  1988-09-02  |  4.3 KB  |  202 lines
  1. *      real function second()
  2.       
  3. *      external msec
  4. *      second = msec()*0.001
  5. *      end
  6. *
  7. *     a TIME function for Ryan/McFarland Fortran and Microsoft Version 4.0
  8.  
  9. *    Author:    M. Steven Baker
  10. *    Date:    September 20, 1986
  11. *
  12.        real function second()
  13.        integer*4 hh,mm,ss,hd
  14.        call gettim(hh,mm,ss,hd)
  15.        second = float(hh)*3600 + float(mm*60+ss) + float(hd)/100
  16.        end
  17.  
  18.  
  19. *$system
  20.  
  21. C WHETSTONE BENCHMARK PROGRAM
  22. C THIS IS SUPPOSED TO USE A MIX OF INSTRUCTIONS
  23. C TYPICAL OF SCIENTIFIC (FLOATING POINT) CALCULATIONS
  24. C TABLE OF TIMES FOR VARIOUS COMPUTERS IN WHETST.ANSWERS
  25. C I=10 CORRESPONDS TO ONE MILLION WHETSTONE INSTRUCTIONS
  26.       real*4 X1,X2,X3,X4,X,Y,Z,T,T1,T2,E1
  27.     real*4 time1,time2,second
  28.       COMMON T,T1,T2,E1(4),J,K,L
  29.     time1=second()
  30.       I=100
  31.       T1=0.50025000
  32.       T=0.499975000
  33.       T2=2.0000
  34. C
  35.       ISAVE=I
  36.       N1=0
  37.       N2=12*I
  38.       N3=14*I
  39.       N4=345*I
  40.       N5=0
  41.       N6=210*I
  42.       N7=32*I
  43.       N8=899*I
  44.       N9=616*I
  45.       N10=0
  46.       N11=93*I
  47.       N12=0
  48.       X1=1.0
  49.       X2=-1.0
  50.       X3=-1.0
  51.       X4=-1.
  52.       IF(N1)19,19,11
  53.    11 DO 18 I=1,N1,1
  54.       X1=(X1+X2+X3-X4)*T
  55.       X2=(X1+X2-X3+X4)*T
  56.       X4=(-X1+X2+X3+X4)*T
  57.       X3=(X1-X2+X3+X4)*T
  58.    18 CONTINUE
  59.    19 CONTINUE
  60. c      CALL POUT(N1,N1,N1,X1,X2,X3,X4)
  61.       E1(1)=1.0
  62.       E1(2)=-1.0
  63.       E1(3)=-1.0
  64.       E1(4)=-1.0
  65.       IF(N2)29,29,21
  66.    21 DO 28 I=1,N2,1
  67.       E1(1)=(E1(1)+E1(2)+E1(3)-E1(4))*T
  68.       E1(2)=(E1(1)+E1(2)-E1(3)+E1(4))*T
  69.       E1(3)=(E1(1)-E1(2)+E1(3)+E1(4))*T
  70.       E1(4)=(-E1(1)+E1(2)+E1(3)+E1(4))*T
  71.    28 CONTINUE
  72.    29 CONTINUE
  73. c      CALL POUT(N2,N3,N2,E1(1),E1(2),E1(3),E1(4))
  74.       IF(N3)39,39,31
  75.    31 DO 38 I=1,N3,1
  76.    38 CALL PA(E1)
  77.   39  CONTINUE
  78. c      CALL POUT(N3,N2,N2,E1(1),E1(2),E1(3),E1(4))
  79.       J=1
  80.       IF(N4)49,49,41
  81.    41 DO 48 I=1,N4,1
  82.       IF(J-1)43,42,43
  83.    42 J=2
  84.       GOTO 44
  85.    43 J=3
  86.    44 IF(J-2)45,46,46
  87.    45 J=0
  88.       GOTO 47
  89.    46 J=1
  90.    47 IF(J-1)411,412,412
  91.   411 J=1
  92.       GOTO 48
  93.   412 J=0
  94.    48 CONTINUE
  95.    49 CONTINUE
  96. c      CALL POUT(N4,J,J,X1,X2,X3,X4)
  97.       J=1
  98.       K=2
  99.       L=3
  100.       IF(N6)69,69,61
  101.    61 DO 68 I=1,N6,1
  102.       J=J*(K-J)*(L-K)
  103.       K=L*K-(L-J)*K
  104.       L=(L-K)*(K+J)
  105.       E1(L-1)=J+K+L
  106.       E1(K-1)=J*K*L
  107.    68 CONTINUE
  108.    69 CONTINUE
  109. c      CALL POUT(N6,J,K,E1(1),E1(2),E1(3),E1(4))
  110.       X=0.5
  111.       Y=0.5
  112.       IF(N7)79,79,71
  113.    71 DO 78 I=1,N7,1
  114.       X=T* ATAN(T2* SIN(X)* COS(X)/( COS(X+Y)+ COS(X-Y)-1.0  ))
  115.       Y=T* ATAN(T2* SIN(Y)* COS(Y)/( COS(X+Y)+ COS(X-Y)-1.0  ))
  116.    78 CONTINUE
  117.    79 CONTINUE
  118. c      CALL POUT(N7,J,K,X,X,Y,Y)
  119.       X=1.0
  120.       Y=1.0
  121.       Z=1.0
  122.       IF(N8)89,89,81
  123.    81 DO 88 I=1,N8,1
  124.    88 CALL P3(X,Y,Z)
  125.    89 CONTINUE
  126. c      CALL POUT(N8,J,K,X,Y,Z,Z)
  127.       J=1
  128.       K=2
  129.       L=3
  130.       E1(1)=1.0
  131.       E1(2)=2.0
  132.       E1(3)=3.0
  133.       IF(N9)99,99,91
  134.    91 DO 98 I=1,N9,1
  135.    98 CALL P0
  136.    99 CONTINUE
  137. c      CALL POUT(N9,J,K,E1(1),E1(2),E1(3),E1(4))
  138.       J=2
  139.       K=3
  140.       IF(N10)109,109,101
  141.   101 DO 108 I=1,N10,1
  142.       J=J+K
  143.       K=J+K
  144.       J=J-K
  145.       K=K-J-J
  146.   108 CONTINUE
  147.   109 CONTINUE
  148. c      CALL POUT(N10,J,K,X1,X2,X3,X4)
  149.       X=0.75
  150.       IF(N11)119,119,111
  151.   111 DO 118 I=1,N11,1
  152.   118 X= SQRT( EXP(LOG(X)/T1))
  153. 119   CONTINUE
  154. c      CALL POUT(N11,J,K,X,X,X,X)
  155.     time2=second()
  156.     time2=time2-time1
  157.       write(*,*) ' elasped time: ',time2
  158.     write(*,*)' execution rate=',100*isave/time2,'K whetstones/sec'
  159.       STOP
  160.       END
  161. C SUBROUTINE PA
  162.       SUBROUTINE PA(E)
  163.       real*4 T,T1,T2,E
  164.       COMMON T,T1,T2
  165.       DIMENSION E(4)
  166.       J=0
  167. 1     E(1)=(E(1)+E(2)+E(3)-E(4))*T
  168.       E(2)=(E(1)+E(2)-E(3)+E(4))*T
  169.       E(3)=(E(1)-E(2)+E(3)+E(4))*T
  170.       E(4)=(-E(1)+E(2)+E(3)+E(4))/T2
  171.       J=J+1
  172.       IF(J-6)1,2,2
  173. 2     CONTINUE
  174.       RETURN
  175.       END
  176. C SUBROUTINE P0
  177.       SUBROUTINE P0
  178.       real*4 T,T1,T2,E1
  179.       COMMON T,T1,T2,E1(4),J,K,L
  180.       E1(J)=E1(K)
  181.       E1(K)=E1(L)
  182.       E1(L)=E1(J)
  183.       RETURN
  184.       END
  185. C SUBROUTINE P3
  186.       SUBROUTINE P3(X,Y,Z)
  187.       real*4 T,T1,T2,X1,Y1,X,Y,Z
  188.       COMMON T,T1,T2
  189.       X=T*(X+Y)
  190.       Y=T*(X+Y)
  191.       Z=(X+Y)/T2
  192.       RETURN
  193.       END
  194. C SUBROUTINE POUT
  195.       SUBROUTINE POUT(N,J,K,X1,X2,X3,X4)
  196.       real*4 X1,X2,X3,X4
  197.       WRITE(6,1)N,J,K,X1,X2,X3,X4
  198. 1     FORMAT(1H ,3I7,4E12.4)
  199.       RETURN
  200.       END
  201.   
  202.